home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / encryp2a / frmmain.frm (.txt) next >
Visual Basic Form  |  1999-09-27  |  9KB  |  239 lines
  1. VERSION 5.00
  2. Begin VB.Form frmMain 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "Encrypt String"
  5.    ClientHeight    =   2310
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   3240
  9.    LinkTopic       =   "Form1"
  10.    MaxButton       =   0   'False
  11.    ScaleHeight     =   2310
  12.    ScaleWidth      =   3240
  13.    StartUpPosition =   1  'CenterOwner
  14.    Begin VB.CommandButton cmdCrypt 
  15.       Caption         =   "Decrypt"
  16.       BeginProperty Font 
  17.          Name            =   "Arial"
  18.          Size            =   9
  19.          Charset         =   0
  20.          Weight          =   700
  21.          Underline       =   0   'False
  22.          Italic          =   0   'False
  23.          Strikethrough   =   0   'False
  24.       EndProperty
  25.       Height          =   255
  26.       Index           =   1
  27.       Left            =   1160
  28.       TabIndex        =   8
  29.       Top             =   2040
  30.       Width           =   1175
  31.    End
  32.    Begin VB.CommandButton cmdCrypt 
  33.       Caption         =   "Encrypt"
  34.       BeginProperty Font 
  35.          Name            =   "Arial"
  36.          Size            =   9
  37.          Charset         =   0
  38.          Weight          =   700
  39.          Underline       =   0   'False
  40.          Italic          =   0   'False
  41.          Strikethrough   =   0   'False
  42.       EndProperty
  43.       Height          =   255
  44.       Index           =   0
  45.       Left            =   0
  46.       TabIndex        =   7
  47.       Top             =   2040
  48.       Width           =   1175
  49.    End
  50.    Begin VB.TextBox txtPW 
  51.       BeginProperty Font 
  52.          Name            =   "Arial"
  53.          Size            =   9.75
  54.          Charset         =   0
  55.          Weight          =   400
  56.          Underline       =   0   'False
  57.          Italic          =   0   'False
  58.          Strikethrough   =   0   'False
  59.       EndProperty
  60.       Height          =   315
  61.       Left            =   70
  62.       TabIndex        =   6
  63.       Top             =   1650
  64.       Width           =   2200
  65.    End
  66.    Begin VB.Frame frmePW 
  67.       Caption         =   "Password:"
  68.       Height          =   590
  69.       Left            =   0
  70.       TabIndex        =   5
  71.       Top             =   1450
  72.       Width           =   2340
  73.    End
  74.    Begin VB.Frame frmeMethod 
  75.       Caption         =   "Method:"
  76.       Height          =   840
  77.       Left            =   2370
  78.       TabIndex        =   2
  79.       Top             =   1450
  80.       Width           =   855
  81.       Begin VB.OptionButton optMethod 
  82.          Caption         =   "2"
  83.          Height          =   255
  84.          Index           =   1
  85.          Left            =   120
  86.          TabIndex        =   4
  87.          Top             =   480
  88.          Width           =   615
  89.       End
  90.       Begin VB.OptionButton optMethod 
  91.          Caption         =   "1"
  92.          Height          =   195
  93.          Index           =   0
  94.          Left            =   120
  95.          TabIndex        =   3
  96.          Top             =   240
  97.          Value           =   -1  'True
  98.          Width           =   375
  99.       End
  100.    End
  101.    Begin VB.TextBox txtText 
  102.       BeginProperty Font 
  103.          Name            =   "Arial"
  104.          Size            =   9.75
  105.          Charset         =   0
  106.          Weight          =   400
  107.          Underline       =   0   'False
  108.          Italic          =   0   'False
  109.          Strikethrough   =   0   'False
  110.       EndProperty
  111.       Height          =   1160
  112.       Left            =   80
  113.       MultiLine       =   -1  'True
  114.       ScrollBars      =   2  'Vertical
  115.       TabIndex        =   1
  116.       Top             =   220
  117.       Width           =   3070
  118.    End
  119.    Begin VB.Frame frmeText 
  120.       Caption         =   "Text To Encrypt/Decrypt:"
  121.       Height          =   1455
  122.       Left            =   0
  123.       TabIndex        =   0
  124.       Top             =   0
  125.       Width           =   3225
  126.    End
  127. Attribute VB_Name = "frmMain"
  128. Attribute VB_GlobalNameSpace = False
  129. Attribute VB_Creatable = False
  130. Attribute VB_PredeclaredId = True
  131. Attribute VB_Exposed = False
  132. '**********************************************************
  133. '*            Encrypt String by Joseph Huntley            *
  134. '*               joseph_huntley@email.com                 *
  135. '*                http://joseph.vr9.com                   *
  136. '*                                                        *
  137. '*  Made: September 28, 1999                              *
  138. '**********************************************************
  139. '*   The forms here are only used to demonstrate how to   *
  140. '* use the function 'EncryptString'. You may copy the     *
  141. '* function into your project for use. If you need any    *
  142. '* help, please e-mail me.                                *
  143. '**********************************************************
  144. Function EncryptString(strString As String, strPassword As String, Optional boolEncrypt As Boolean = True, Optional intMethod As Integer = 1)
  145. '**********************************************************
  146. '*            Encrypt String by Joseph Huntley            *
  147. '*               joseph_huntley@email.com                 *
  148. '*                http://joseph.vr9.com                   *
  149. '**********************************************************
  150. '*   You may use this code freely as long as credit is    *
  151. '* given to the author, and the header remains intact.    *
  152. '**********************************************************
  153. '--------------------- The Arguments ----------------------
  154. 'strString    - The string you want to encrypt.
  155. 'strPassword  - The password you want to use.
  156. 'boolEncrypt  - True to encrypt. False to decrypt.
  157. 'intMethod    - The encryption type to use.
  158. '----------------------------------------------------------
  159. Dim intBuffer As Integer, intPWChar As Integer
  160. Dim strEndString As String, strChar As String, strEndChar As String
  161. Dim lngPWChar As Long, lngChar As Long
  162. Dim sngChar As Single, sngBuf As Single
  163.   If strPassword$ = "" Then
  164.      EncryptString = strString$
  165.      Exit Function
  166.   End If
  167.        If boolEncrypt Then
  168.            For intBuffer% = 1 To Len(strString$)
  169.                strChar$ = Mid$(strString$, intBuffer%, 1)
  170.                intPWChar% = intPWChar% + 1
  171.                If intPWChar% > Len(strPassword$) Then intPWChar% = 1
  172.                lngPWChar& = Asc(Mid$(strPassword$, intPWChar%, 1))
  173.                  
  174.                   Select Case intMethod%
  175.                      Case 1:
  176.                         lngChar& = Asc(strChar$) + lngPWChar&
  177.                         If lngChar& > 255 Then lngChar& = lngChar& - 255
  178.                         strEndChar$ = Chr$(lngChar&) & Chr$(CInt(lngChar& / 2))
  179.                      Case 2:
  180.                         sngChar! = Asc(strChar$) / 2
  181.                         sngBuf! = Asc(strChar$) / 2
  182.                             If InStr(CStr(sngChar!), ".") Then
  183.                                sngChar! = CSng(Left$(CStr(sngChar!), InStr(CStr(sngChar!), ".") - 1))
  184.                                sngBuf! = CSng(Left$(CStr(sngBuf!), InStr(CStr(sngBuf!), ".") - 1)) + 1
  185.                             End If
  186.                         sngChar! = sngChar! + lngPWChar&
  187.                         If sngChar! > 255 Then sngChar! = sngChar! - 255
  188.                         strEndChar$ = Chr$(sngChar!) & Chr$(sngBuf!)
  189.                   End Select
  190.                        
  191.                strEndString$ = strEndString$ & strEndChar$
  192.            Next intBuffer%
  193.        Else
  194.            For intBuffer% = 1 To Len(strString$) Step 2
  195.                strChar$ = Mid$(strString$, intBuffer%, 1)
  196.                intPWChar% = intPWChar% + 1
  197.                If intPWChar% > Len(strPassword$) Then intPWChar% = 1
  198.                lngPWChar& = Asc(Mid$(strPassword$, intPWChar%, 1))
  199.                  
  200.                   Select Case intMethod%
  201.                      Case 1:
  202.                         lngChar& = Asc(strChar$) - lngPWChar&
  203.                         If lngChar& < 0 Then lngChar& = lngChar& + 255
  204.                         strEndChar$ = Chr$(lngChar&)
  205.                      Case 2:
  206.                         sngChar! = (Asc(strChar$) - lngPWChar&) + Asc(Mid$(strString$, intBuffer% + 1, 1))
  207.                         If sngChar! < 0 Then sngChar! = sngChar! + 255
  208.                         strEndChar$ = Chr$(sngChar!)
  209.                   End Select
  210.                        
  211.                st